# Análisis descriptivo de la variable dependiente
tabla_depresion <- table(datos$depresion, useNA = "ifany")
prop_depresion <- prop.table(tabla_depresion) * 100
# Crear tabla de depresión
kable(
data.frame(
Categoría = names(tabla_depresion),
Frecuencia = as.numeric(tabla_depresion),
Porcentaje = round(as.numeric(prop_depresion), 2)
),
caption = "Distribución de Depresión",
col.names = c("Categoría", "Frecuencia", "Porcentaje (%)"),
align = c("l", "r", "r")
)| Categoría | Frecuencia | Porcentaje (%) |
|---|---|---|
| Si | 3829 | 18.78 |
| No | 16365 | 80.25 |
| NA | 198 | 0.97 |
# Gráfico de depresión
p <- ggplot(data = datos, aes(x = depresion, fill = depresion)) +
geom_bar() +
labs(
title = "Distribución de Depresión en la Población",
subtitle = "Basado en diagnóstico médico reportado",
x = "Diagnóstico de Depresión",
y = "Número de Personas",
caption = "Fuente: Encuesta Nacional de Salud Sexual (ENSSEX)"
) +
scale_fill_brewer(palette = "Set2") +
theme(
plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
plot.subtitle = element_text(hjust = 0.5, size = 12),
axis.title = element_text(size = 11),
legend.title = element_text(size = 10),
legend.position = "bottom"
)
print(p)
# Análisis de variables categóricas
vars_cat <- c("sexo_al_nacer", "nivel_educacional", "bienestar_emocional",
"calidad_vida_percibida", "satisfaccion_aspecto_fisico",
"consumo_tranquilizantes", "consumo_alcohol")
titulos_cat <- c("Sexo al Nacer", "Nivel Educacional", "Bienestar Emocional",
"Calidad de Vida Percibida", "Satisfacción Aspecto Físico",
"Consumo de Tranquilizantes", "Consumo de Alcohol")
# Función para analizar variables categóricas
analizar_categorica <- function(datos, variable, titulo) {
# Tabla
tabla <- table(datos[[variable]], useNA = "ifany")
prop <- prop.table(tabla) * 100
# Crear tabla
kable(
data.frame(
Categoría = names(tabla),
Frecuencia = as.numeric(tabla),
Porcentaje = round(as.numeric(prop), 2)
),
caption = paste("Distribución de", titulo),
col.names = c("Categoría", "Frecuencia", "Porcentaje (%)"),
align = c("l", "r", "r")
)
# Gráfico
p <- ggplot(data = datos, aes_string(x = variable, fill = variable)) +
geom_bar() +
labs(
title = paste("Distribución de", titulo),
subtitle = "Análisis de frecuencias por categoría",
x = titulo,
y = "Número de Personas",
caption = "Fuente: ENSSEX"
) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
plot.subtitle = element_text(hjust = 0.5, size = 12),
axis.title = element_text(size = 11),
legend.position = "none"
) +
scale_fill_brewer(palette = "Set3")
print(p)
}
# Analizar cada variable categórica
for(i in seq_along(vars_cat)) {
cat(paste("\n##", titulos_cat[i], "\n"))
analizar_categorica(datos, vars_cat[i], titulos_cat[i])
}##
## ## Sexo al Nacer

##
## ## Nivel Educacional

##
## ## Bienestar Emocional

##
## ## Calidad de Vida Percibida

##
## ## Satisfacción Aspecto Físico

##
## ## Consumo de Tranquilizantes

##
## ## Consumo de Alcohol

# Análisis de variables numéricas
vars_num <- c("edad", "peso", "talla")
titulos_num <- c("Edad (años)", "Peso (kg)", "Talla (cm)")
# Función para analizar variables numéricas
analizar_numerica <- function(datos, variable, titulo) {
# Resumen estadístico
resumen <- summary(datos[[variable]])
sd_val <- sd(datos[[variable]], na.rm = TRUE)
# Crear tabla de resumen
kable(
data.frame(
Estadístico = c("Mínimo", "1er Cuartil", "Mediana", "Media", "3er Cuartil", "Máximo", "Desv. Est."),
Valor = c(as.numeric(resumen), round(sd_val, 2))
),
caption = paste("Resumen estadístico de", titulo),
align = c("l", "r")
)
# Histograma
p1 <- ggplot(data = datos, aes_string(x = variable)) +
geom_histogram(aes(y = ..density..), bins = 30, fill = "skyblue", color = "black") +
geom_density(color = "red", size = 1) +
labs(
title = paste("Distribución de", titulo),
subtitle = "Histograma y curva de densidad",
x = titulo,
y = "Densidad",
caption = "La línea roja representa la curva de densidad"
) +
theme(
plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
plot.subtitle = element_text(hjust = 0.5, size = 12),
axis.title = element_text(size = 11)
)
# Boxplot
p2 <- ggplot(data = datos, aes_string(y = variable)) +
geom_boxplot(fill = "skyblue") +
labs(
title = paste("Diagrama de Caja de", titulo),
subtitle = "Visualización de la distribución y valores atípicos",
y = titulo,
caption = "Los puntos representan valores atípicos"
) +
theme(
plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
plot.subtitle = element_text(hjust = 0.5, size = 12),
axis.title = element_text(size = 11)
)
print(p1)
print(p2)
}
# Analizar cada variable numérica
for(i in seq_along(vars_num)) {
cat(paste("\n##", titulos_num[i], "\n"))
analizar_numerica(datos, vars_num[i], titulos_num[i])
}##
## ## Edad (años)


##
## ## Peso (kg)


##
## ## Talla (cm)


# Para variables categóricas
for(i in seq_along(vars_cat)) {
cat(paste("\n## Depresión vs", titulos_cat[i], "\n"))
# Tabla de contingencia
tabla_cont <- table(datos$depresion, datos[[vars_cat[i]]])
print(kable(tabla_cont,
caption = paste("Tabla de contingencia: Depresión vs", titulos_cat[i])))
# Test Chi-cuadrado
chi_test <- chisq.test(tabla_cont)
cat("\nTest Chi-cuadrado:\n")
print(chi_test)
# Gráfico de barras apiladas
p <- ggplot(datos, aes_string(x = vars_cat[i], fill = "depresion")) +
geom_bar(position = "fill") +
labs(
title = paste("Relación entre Depresión y", titulos_cat[i]),
subtitle = "Proporción de casos por categoría",
x = titulos_cat[i],
y = "Proporción",
fill = "Diagnóstico de Depresión",
caption = "Fuente: ENSSEX"
) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
plot.subtitle = element_text(hjust = 0.5, size = 12),
axis.title = element_text(size = 11),
legend.position = "bottom"
)
print(p)
}##
## ## Depresión vs Sexo al Nacer
##
##
## Table: Tabla de contingencia: Depresión vs Sexo al Nacer
##
## | | Hombre| Mujer|
## |:--|------:|-----:|
## |Si | 657| 3172|
## |No | 6107| 10258|
##
## Test Chi-cuadrado:
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: tabla_cont
## X-squared = 565.18, df = 1, p-value < 2.2e-16

##
## ## Depresión vs Nivel Educacional
##
##
## Table: Tabla de contingencia: Depresión vs Nivel Educacional
##
## | | 1| 3| 5| 6| 7| 8| 9| 10| 11| 12| 13| 14| 15| 16| 17|
## |:--|---:|--:|--:|---:|----:|---:|----:|---:|----:|---:|----:|----:|----:|--:|---:|
## |Si | 48| 0| 1| 126| 775| 130| 1176| 84| 287| 153| 323| 249| 424| 16| 37|
## |No | 145| 1| 9| 390| 2363| 706| 5657| 437| 1387| 677| 1476| 1083| 1869| 42| 123|
##
## Test Chi-cuadrado:
##
## Pearson's Chi-squared test
##
## data: tabla_cont
## X-squared = 114.96, df = 14, p-value < 2.2e-16

##
## ## Depresión vs Bienestar Emocional
##
##
## Table: Tabla de contingencia: Depresión vs Bienestar Emocional
##
## | | 1| 2| 3| 4| 5| 6| 7| 9|
## |:--|---:|---:|---:|----:|----:|----:|----:|--:|
## |Si | 187| 145| 331| 721| 1077| 823| 542| 3|
## |No | 131| 144| 475| 1660| 3919| 5192| 4816| 28|
##
## Test Chi-cuadrado:
##
## Pearson's Chi-squared test
##
## data: tabla_cont
## X-squared = 1372.2, df = 7, p-value < 2.2e-16

##
## ## Depresión vs Calidad de Vida Percibida
##
##
## Table: Tabla de contingencia: Depresión vs Calidad de Vida Percibida
##
## | | 1| 2| 3| 4| 5| 8| 9|
## |:--|---:|---:|----:|----:|----:|--:|--:|
## |Si | 46| 199| 1264| 2011| 300| 6| 3|
## |No | 123| 324| 3512| 9880| 2493| 23| 10|
##
## Test Chi-cuadrado:
##
## Pearson's Chi-squared test
##
## data: tabla_cont
## X-squared = 462.08, df = 6, p-value < 2.2e-16

##
## ## Depresión vs Satisfacción Aspecto Físico
##
##
## Table: Tabla de contingencia: Depresión vs Satisfacción Aspecto Físico
##
## | | 1| 2| 3| 4| 5| 8| 9|
## |:--|---:|----:|----:|----:|----:|--:|--:|
## |Si | 151| 742| 717| 1843| 370| 5| 1|
## |No | 359| 1534| 3042| 9277| 2104| 37| 12|
##
## Test Chi-cuadrado:
##
## Pearson's Chi-squared test
##
## data: tabla_cont
## X-squared = 382.74, df = 6, p-value < 2.2e-16

##
## ## Depresión vs Consumo de Tranquilizantes
##
##
## Table: Tabla de contingencia: Depresión vs Consumo de Tranquilizantes
##
## | | Si| No|
## |:--|----:|-----:|
## |Si | 1751| 2056|
## |No | 952| 15264|
##
## Test Chi-cuadrado:
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: tabla_cont
## X-squared = 4247.2, df = 1, p-value < 2.2e-16

##
## ## Depresión vs Consumo de Alcohol
##
##
## Table: Tabla de contingencia: Depresión vs Consumo de Alcohol
##
## | | 1| 2| 3| 9|
## |:--|----:|----:|----:|--:|
## |Si | 1725| 498| 470| 3|
## |No | 7340| 1913| 1262| 15|
##
## Test Chi-cuadrado:
##
## Pearson's Chi-squared test
##
## data: tabla_cont
## X-squared = 59.173, df = 3, p-value = 8.831e-13

# Para variables numéricas
for(i in seq_along(vars_num)) {
cat(paste("\n## Depresión vs", titulos_num[i], "\n"))
# Test t
t_test <- t.test(datos[[vars_num[i]]] ~ datos$depresion)
cat("\nTest t:\n")
print(t_test)
# Boxplot
p <- ggplot(datos, aes_string(x = "depresion", y = vars_num[i], fill = "depresion")) +
geom_boxplot() +
labs(
title = paste("Comparación de", titulos_num[i], "según Diagnóstico de Depresión"),
subtitle = "Distribución y valores atípicos por grupo",
x = "Diagnóstico de Depresión",
y = titulos_num[i],
caption = "Los puntos representan valores atípicos"
) +
theme(
plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
plot.subtitle = element_text(hjust = 0.5, size = 12),
axis.title = element_text(size = 11),
legend.position = "none"
)
print(p)
}##
## ## Depresión vs Edad (años)
##
## Test t:
##
## Welch Two Sample t-test
##
## data: datos[[vars_num[i]]] by datos$depresion
## t = 12.458, df = 5912.1, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group Si and group No is not equal to 0
## 95 percent confidence interval:
## 3.324843 4.566644
## sample estimates:
## mean in group Si mean in group No
## 48.19169 44.24595

##
## ## Depresión vs Peso (kg)
##
## Test t:
##
## Welch Two Sample t-test
##
## data: datos[[vars_num[i]]] by datos$depresion
## t = 0.96198, df = 5622.4, p-value = 0.3361
## alternative hypothesis: true difference in means between group Si and group No is not equal to 0
## 95 percent confidence interval:
## -0.3599752 1.0536571
## sample estimates:
## mean in group Si mean in group No
## 71.74171 71.39487

##
## ## Depresión vs Talla (cm)
##
## Test t:
##
## Welch Two Sample t-test
##
## data: datos[[vars_num[i]]] by datos$depresion
## t = -8.2629, df = 5530.1, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group Si and group No is not equal to 0
## 95 percent confidence interval:
## -4.996640 -3.080358
## sample estimates:
## mean in group Si mean in group No
## 155.4928 159.5313

# Seleccionar variables para el modelo
variables_modelo <- c(
"depresion", "sexo_al_nacer", "nivel_educacional", "bienestar_emocional",
"calidad_vida_percibida", "satisfaccion_aspecto_fisico", "consumo_tranquilizantes",
"consumo_alcohol", "edad", "peso", "talla"
)
# Crear conjunto de datos para modelado
datos_modelo <- datos[, variables_modelo]
datos_modelo <- na.omit(datos_modelo)
# Dividir datos en entrenamiento y prueba
set.seed(123)
indices_train <- createDataPartition(datos_modelo$depresion, p = 0.7, list = FALSE)
datos_entrenamiento <- datos_modelo[indices_train,]
datos_prueba <- datos_modelo[-indices_train,]# Configuración de la validación cruzada
set.seed(123)
control <- trainControl(
method = "cv",
number = 3,
classProbs = TRUE,
summaryFunction = twoClassSummary,
verboseIter = TRUE
)
# Entrenamiento del modelo
rf_model <- train(
depresion ~ .,
data = datos_entrenamiento,
method = "rf",
metric = "ROC",
trControl = control,
ntree = 100,
importance = TRUE
)## + Fold1: mtry= 2
## - Fold1: mtry= 2
## + Fold1: mtry=21
## - Fold1: mtry=21
## + Fold1: mtry=41
## - Fold1: mtry=41
## + Fold2: mtry= 2
## - Fold2: mtry= 2
## + Fold2: mtry=21
## - Fold2: mtry=21
## + Fold2: mtry=41
## - Fold2: mtry=41
## + Fold3: mtry= 2
## - Fold3: mtry= 2
## + Fold3: mtry=21
## - Fold3: mtry=21
## + Fold3: mtry=41
## - Fold3: mtry=41
## Aggregating results
## Selecting tuning parameters
## Fitting mtry = 21 on full training set
# Importancia de variables
var_importance <- varImp(rf_model)
plot(var_importance, top = 10, main = "Top 10 Variables más Importantes")# Entrenamiento del modelo
rl_model <- train(
depresion ~ .,
data = datos_entrenamiento,
method = "glm",
family = "binomial",
metric = "ROC",
trControl = control
)## + Fold1: parameter=none
## - Fold1: parameter=none
## + Fold2: parameter=none
## - Fold2: parameter=none
## + Fold3: parameter=none
## - Fold3: parameter=none
## Aggregating results
## Fitting final model on full training set
# Predicciones
predicciones_rl <- predict(rl_model, datos_prueba)
predicciones_prob_rl <- predict(rl_model, datos_prueba, type = "prob")
# Matriz de confusión
tabla_confusion <- table(Predicho = predicciones_rl, Real = datos_prueba$depresion)
print(kable(tabla_confusion, caption = "Matriz de Confusión - Regresión Logística"))##
##
## Table: Matriz de Confusión - Regresión Logística
##
## | | Si| No|
## |:--|---:|----:|
## |Si | 360| 163|
## |No | 447| 2987|
# Métricas
exactitud <- sum(diag(tabla_confusion)) / sum(tabla_confusion)
sensibilidad <- tabla_confusion[1,1] / sum(tabla_confusion[,1])
especificidad <- tabla_confusion[2,2] / sum(tabla_confusion[,2])
metricas <- data.frame(
Metrica = c("Exactitud", "Sensibilidad", "Especificidad"),
Valor = c(exactitud, sensibilidad, especificidad)
)
print(kable(metricas, caption = "Métricas de Rendimiento - Regresión Logística"))##
##
## Table: Métricas de Rendimiento - Regresión Logística
##
## |Metrica | Valor|
## |:-------------|---------:|
## |Exactitud | 0.8458428|
## |Sensibilidad | 0.4460967|
## |Especificidad | 0.9482540|
# Predicciones Random Forest
predicciones_rf <- predict(rf_model, datos_prueba)
tabla_rf <- table(Predicho = predicciones_rf, Real = datos_prueba$depresion)
# Métricas para ambos modelos
metricas_comparacion <- data.frame(
Modelo = c("Random Forest", "Regresión Logística"),
Exactitud = c(
sum(diag(tabla_rf)) / sum(tabla_rf),
exactitud
),
Sensibilidad = c(
tabla_rf[1,1] / sum(tabla_rf[,1]),
sensibilidad
),
Especificidad = c(
tabla_rf[2,2] / sum(tabla_rf[,2]),
especificidad
)
)
print(kable(metricas_comparacion, caption = "Comparación de Modelos"))##
##
## Table: Comparación de Modelos
##
## |Modelo | Exactitud| Sensibilidad| Especificidad|
## |:-------------------|---------:|------------:|-------------:|
## |Random Forest | 0.8354814| 0.4411400| 0.9365079|
## |Regresión Logística | 0.8458428| 0.4460967| 0.9482540|
# Visualización
par(mfrow = c(1, 2))
barplot(t(as.matrix(tabla_rf)), beside = TRUE, main = "Random Forest",
col = c("skyblue", "lightgreen"), legend.text = c("Si", "No"))
barplot(t(as.matrix(tabla_confusion)), beside = TRUE, main = "Regresión Logística",
col = c("skyblue", "lightgreen"), legend.text = c("Si", "No"))# Asegurar que estamos usando pROC
library(pROC)
# Convertir la variable respuesta a binaria (0/1)
datos_prueba$depresion_bin <- as.numeric(datos_prueba$depresion == "Si")
# Obtener predicciones de probabilidad
pred_prob_rf <- predict(rf_model, datos_prueba, type = "prob")[,"Si"]
pred_prob_rl <- predict(rl_model, datos_prueba, type = "prob")[,"Si"]
# Verificar la estructura de los datos
print("Estructura de los datos:")## [1] "Estructura de los datos:"
## num [1:3957] 0.56 0.18 0.05 0.05 0 0.14 0.84 0.23 0.51 0.05 ...
## num [1:3957] 0.7607 0.1661 0.0783 0.1161 0.0655 ...
##
## 0 1
## 3150 807
# Calcular curvas ROC usando pROC explícitamente
roc_rf <- pROC::roc(datos_prueba$depresion_bin ~ pred_prob_rf)
roc_rl <- pROC::roc(datos_prueba$depresion_bin ~ pred_prob_rl)
# Calcular AUC
auc_rf <- pROC::auc(roc_rf)
auc_rl <- pROC::auc(roc_rl)
# Crear gráfico de curvas ROC
par(mfrow = c(1,1))
plot(roc_rf, col = "blue", main = "Curvas ROC - Comparación de Modelos",
xlab = "Tasa de Falsos Positivos (1 - Especificidad)",
ylab = "Tasa de Verdaderos Positivos (Sensibilidad)")
lines(roc_rl, col = "red")
legend("bottomright",
legend = c(paste("Random Forest (AUC =", round(auc_rf, 3), ")"),
paste("Regresión Logística (AUC =", round(auc_rl, 3), ")")),
col = c("blue", "red"),
lwd = 2)
abline(0, 1, lty = 2, col = "gray")# Tabla comparativa de AUC
auc_comparacion <- data.frame(
Modelo = c("Random Forest", "Regresión Logística"),
AUC = c(auc_rf, auc_rl)
)
print(kable(auc_comparacion,
caption = "Comparación de Área Bajo la Curva (AUC)",
digits = 3))##
##
## Table: Comparación de Área Bajo la Curva (AUC)
##
## |Modelo | AUC|
## |:-------------------|-----:|
## |Random Forest | 0.806|
## |Regresión Logística | 0.830|
# Puntos de corte óptimos usando el índice de Youden
coords_rf <- coords(roc_rf, "best", best.method = "youden")
coords_rl <- coords(roc_rl, "best", best.method = "youden")
puntos_corte <- data.frame(
Modelo = c("Random Forest", "Regresión Logística"),
Punto_Corte = c(coords_rf$threshold, coords_rl$threshold),
Sensibilidad = c(coords_rf$sensitivity, coords_rl$sensitivity),
Especificidad = c(coords_rf$specificity, coords_rl$specificity)
)
print(kable(puntos_corte,
caption = "Puntos de Corte Óptimos",
digits = 3))##
##
## Table: Puntos de Corte Óptimos
##
## |Modelo | Punto_Corte| Sensibilidad| Especificidad|
## |:-------------------|-----------:|------------:|-------------:|
## |Random Forest | 0.255| 0.693| 0.797|
## |Regresión Logística | 0.208| 0.691| 0.838|
# Resumen final de métricas
metricas_finales <- data.frame(
Modelo = c("Random Forest", "Regresión Logística"),
AUC = c(auc_rf, auc_rl),
Exactitud = metricas_comparacion$Exactitud,
Sensibilidad = metricas_comparacion$Sensibilidad,
Especificidad = metricas_comparacion$Especificidad
)
print(kable(metricas_finales,
caption = "Resumen Final de Métricas de Rendimiento",
digits = 3))##
##
## Table: Resumen Final de Métricas de Rendimiento
##
## |Modelo | AUC| Exactitud| Sensibilidad| Especificidad|
## |:-------------------|-----:|---------:|------------:|-------------:|
## |Random Forest | 0.806| 0.835| 0.441| 0.937|
## |Regresión Logística | 0.830| 0.846| 0.446| 0.948|
# Visualización comparativa final
par(mfrow = c(1, 2))
# Gráfico de métricas
barplot(t(as.matrix(metricas_finales[,c("Exactitud", "Sensibilidad", "Especificidad")])),
beside = TRUE,
main = "Comparación de Métricas",
col = c("skyblue", "lightgreen"),
legend.text = rownames(metricas_finales),
args.legend = list(x = "topright"))
# Gráfico de AUC
barplot(metricas_finales$AUC,
names.arg = metricas_finales$Modelo,
main = "Comparación de AUC",
col = c("skyblue", "lightgreen"),
ylim = c(0, 1))Los resultados del análisis muestran: